home *** CD-ROM | disk | FTP | other *** search
/ Complete Linux / Complete Linux.iso / docs / apps / circuits / spice2g6.z / spice2g6 / spice / Fortran / plot.f < prev    next >
Encoding:
Text File  |  1989-02-03  |  5.6 KB  |  202 lines
  1.       subroutine plot(numpnt,locx,locy,locv)
  2.       implicit double precision (a-h,o-z)
  3. c
  4. c     this routine generates the line-printer plots.
  5. c
  6. c spice version 2g.6  sccsid=miscel 3/15/83
  7.       common /miscel/ atime,aprog(3),adate,atitle(10),defl,defw,defad,
  8.      1  defas,rstats(50),iwidth,lwidth,nopage
  9. c spice version 2g.6  sccsid=status 3/15/83
  10.       common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet,
  11.      1   xmu,sfactr,mode,modedc,icalc,initf,method,iord,maxord,noncon,
  12.      2   iterno,itemno,nosolv,modac,ipiv,ivmflg,ipostp,iscrch,iofile
  13. c spice version 2g.6  sccsid=knstnt 3/15/83
  14.       common /knstnt/ twopi,xlog2,xlog10,root2,rad,boltz,charge,ctok,
  15.      1   gmin,reltol,abstol,vntol,trtol,chgtol,eps0,epssil,epsox,
  16.      2   pivtol,pivrel
  17. c spice version 2g.6  sccsid=outinf 3/15/83
  18.       common /outinf/ xincr,string(15),xstart,yvar(8),itab(8),itype(8),
  19.      1   ilogy(8),npoint,numout,kntr,numdgt
  20. c spice version 2g.6  sccsid=blank 3/15/83
  21.       common /blank/ value(200000)
  22.       integer nodplc(64)
  23.       complex cvalue(32)
  24.       equivalence (value(1),nodplc(1),cvalue(1))
  25. c
  26. c
  27.       integer xxor
  28.       dimension ycoor(5,8),icoor(8),delplt(8)
  29.       dimension agraph(13),aplot(13)
  30.       dimension asym(2),pmin(8),jcoor(8)
  31.       data ablnk, aletx, aper / 1h , 1hx, 1h. /
  32.       data asym1, asym2, arprn / 8h(-------, 8h--------, 1h) /
  33.       data pltsym / 8h*+=$0<>? /
  34. c
  35. c
  36.       iwide=1
  37.       nwide=101
  38.       nwide4=25
  39.       if(lwidth.gt.80) go to 3
  40.       iwide=0
  41.       nwide=57
  42.       nwide4=14
  43.     3 if (numpnt.le.0) go to 400
  44.       do 5 i=1,13
  45.       agraph(i)=ablnk
  46.     5 continue
  47.       do 7 i=1,5
  48.       ispot=1+nwide4*(i-1)
  49.       call move(agraph,ispot,aper,1,1)
  50.     7 continue
  51.       locyt=locy
  52.       lspot=locv-1
  53.       mltscl=0
  54.       if (value(locv).eq.0.0d0) mltscl=1
  55.       do 235 k=1,kntr
  56.       lspot=lspot+2
  57.       ymin=value(lspot)
  58.       ymax=value(lspot+1)
  59.       if (ymin.ne.0.0d0) go to 10
  60.       if (ymax.ne.0.0d0) go to 10
  61.       go to 100
  62.    10 ymin1=dmin1(ymin,ymax)
  63.       ymax1=dmax1(ymin,ymax)
  64.    30 if (ilogy(k).eq.1) go to 40
  65.       ymin1=dlog10(dmax1(ymin1,1.0d-20))
  66.       ymax1=dlog10(dmax1(ymax1,1.0d-20))
  67.       del=dmax1(ymax1-ymin1,0.0001d0)/4.0d0
  68.       go to 50
  69.    40 del=dmax1(ymax1-ymin1,1.0d-20)/4.0d0
  70.    50 ymin=ymin1
  71.       ymax=ymax1
  72.       go to 200
  73. c
  74. c  determine max and min values
  75. c
  76.   100 ymax1=value(locyt+1)
  77.       ymin1=ymax1
  78.       if (numpnt.eq.1) go to 150
  79.       do 110 i=2,numpnt
  80.       ymin1=dmin1(ymin1,value(locyt+i))
  81.       ymax1=dmax1(ymax1,value(locyt+i))
  82.   110 continue
  83. c
  84. c  scaling
  85. c
  86.   150 call scale(ymin1,ymax1,4,ymin,ymax,del)
  87. c
  88. c  determine coordinates
  89. c
  90.   200 ycoor(1,k)=ymin
  91.       pmin(k)=ymin
  92.       small=del*1.0d-4
  93.       if (dabs(ycoor(1,k)).le.small) ycoor(1,k)=0.0d0
  94.       do 210 i=1,4
  95.       ycoor(i+1,k)=ycoor(i,k)+del
  96.       if (dabs(ycoor(i+1,k)).le.small) ycoor(i+1,k)=0.0d0
  97.   210 continue
  98.       if (ilogy(k).eq.1) go to 230
  99.       do 220 i=1,5
  100.   220 ycoor(i,k)=dexp(xlog10*ycoor(i,k))
  101.   230 delplt(k)=del/dble(nwide4)
  102.       locyt=locyt+npoint
  103.   235 continue
  104. c
  105. c  count distinct coordinates
  106. c
  107.       icoor(1)=1
  108.       jcoor(1)=1
  109.       numcor=1
  110.       if (kntr.eq.1) go to 290
  111.       do 250 i=2,kntr
  112.       do 245 j=1,numcor
  113.       l=jcoor(j)
  114. c...  coordinates are *equal* if the most significant 24 bits agree
  115.       do 240 k=1,5
  116. c*****************************************************************
  117. c  temporarily check 'equality' this way
  118.       y1=ycoor(k,i)
  119.       y2=ycoor(k,l)
  120.       if(y1.eq.0.0d0.and.y2.eq.0.0d0) go to 240
  121.       if(dabs((y1-y2)/dmax1(dabs(y1),dabs(y2))).ge.1.0d-7) go to 245
  122.   240 continue
  123.       icoor(i)=l
  124.       go to 250
  125.   245 continue
  126.       icoor(i)=i
  127.       numcor=numcor+1
  128.       jcoor(numcor)=i
  129.   250 continue
  130. c
  131. c  print coordinates
  132. c
  133.   260 do 280 i=1,numcor
  134.       asym(1)=asym1
  135.       asym(2)=asym2
  136.       ipos=2
  137.       do 270 j=1,kntr
  138.       if (icoor(j).ne.jcoor(i)) go to 270
  139.       call move(asym,ipos,pltsym,j,1)
  140.       ipos=ipos+1
  141.   270 continue
  142.       call move(asym,ipos,arprn,1,1)
  143.       k=jcoor(i)
  144.       if(iwide.ne.0) write(iofile,271) asym,(ycoor(j,k),j=1,5)
  145.   271 format(/2a8,4h----,1pd12.3,4(15x,d10.3)/26x,51(2h -))
  146.       if(iwide.eq.0) write(iofile,273) asym,(ycoor(j,k),j=1,5)
  147.   273 format(/2a8,1x,1pd10.3,3(4x,d10.3),1x,d10.3/22x,29(2h -))
  148.   280 continue
  149.       go to 300
  150.   290 if(iwide.ne.0) write(iofile,291) (ycoor(j,1),j=1,5)
  151.   291 format(/20x,1pd12.3,4(15x,d10.3)/26x,51(2h -))
  152.       if(iwide.eq.0) write(iofile,293) (ycoor(j,1),j=1,5)
  153.   293 format(/15x,1pd12.3,3(4x,d10.3),1x,d10.3/22x,29(2h -))
  154. c
  155. c  plotting
  156. c
  157.   300 aspot=ablnk
  158.       do 320 i=1,numpnt
  159.       xvar=value(locx+i)
  160.       locyt=locy
  161.       call copy8(agraph,aplot,13)
  162.       do 310 k=1,kntr
  163.       yvr=value(locyt+i)
  164.       ktmp=icoor(k)
  165.       ymin1=pmin(ktmp)
  166.       jpoint=idint((yvr-ymin1)/delplt(k)+0.5d0)+1
  167.       if (jpoint.le.0) go to 306
  168.       if (jpoint.gt.nwide) go to 306
  169.       call move(aspot,1,aplot,jpoint,1)
  170.       if (aspot.eq.ablnk) go to 303
  171.       if (aspot.eq.aper) go to 303
  172.       call move(aplot,jpoint,aletx,1,1)
  173.       go to 306
  174.   303 call move(aplot,jpoint,pltsym,k,1)
  175.   306 locyt=locyt+npoint
  176.   310 continue
  177.       yvr=value(locy+i)
  178.       if (ilogy(1).eq.1) go to 315
  179.       yvr=dexp(xlog10*yvr)
  180.   315 if(iwide.ne.0) write(iofile,316) xvar,yvr,aplot
  181.   316 format(1pd10.3,3x,d10.3,3x,13a8)
  182.       if(iwide.eq.0) write(iofile,317) xvar,yvr,(aplot(k),k=1,8)
  183.   317 format(1pd10.3,1x,d10.3,1x,7a8,a1)
  184.   320 continue
  185. c
  186. c  finished
  187. c
  188.       if(iwide.ne.0) write(iofile,331)
  189.   331 format(26x,51(2h -)//)
  190.       if(iwide.eq.0) write(iofile,332)
  191.   332 format(22x,29(2h -)//)
  192.       go to 500
  193. c
  194. c  too few points
  195. c
  196.   400 write (iofile,401)
  197.   401 format('0warning:  too few points for plotting'/)
  198.   500 write (iofile,501)
  199.   501 format(1hy)
  200.       return
  201.       end
  202.